home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1999 February
/
EnigmA AMIGA RUN 34 (1999)(G.R. Edizioni)(IT)[!][issue 1999-02].iso
/
earcd
/
-recent3
/
wreplaceicon.lha
/
WReplaceIcon
/
WReplaceIcon.e
< prev
next >
Wrap
Text File
|
1999-02-13
|
6KB
|
199 lines
-> WReplaceIcon V1.0 by Jilles Tjoelker 1999-02-13
-> Requires V41 BGUI modules, though V40 library should work
-> TAB=2
OPT PREPROCESS,OSVERSION=37
MODULE 'bgui','libraries/bgui','libraries/bguic','libraries/bgui_macros',
'tools/boopsi','utility/tagitem','intuition/screens',
'intuition/gadgetclass','intuition/classusr','intuition/intuition',
'intuition/classes','workbench/workbench','icon',
'workbench/startup'
ENUM ID_NULL,ID_SRC,ID_ABOUT
ENUM ERR_NONE,ERR_LIB,ERR_GUI,ERR_WIN
RAISE ERR_LIB IF OpenLibrary()=NIL
DEF wd_obj=NIL,sig,done,wnd
PROC bguireq(title,text,gadgets,args=NIL)
DEF rq:bguirequest
rq.flags:=BREQF_AUTO_ASPECT OR BREQF_LOCKWINDOW OR
(IF InStr(gadgets,'*')<>-1 THEN BREQF_FAST_KEYS ELSE 0)
rq.title:=title
rq.gadgetformat:=gadgets
rq.textformat:=text
rq.reqpos:=POS_CENTERMOUSE
rq.textattr:=NIL
rq.underscore:="_"
rq.reserved0:=0
rq.screen:=NIL -> NOP
rq.reserved1:=0
ENDPROC BgUI_RequestA(wnd,rq,args)
INT 0
verstag:
CHAR '$VER: WReplaceIcon 1.0 (13.2.99)',0
PROC main() HANDLE
DEF amsg:PTR TO appmessage,wa:PTR TO wbarg,cd
DEF name[256]:STRING
DEF rc,i
DEF oldgadget:gadget
DEF g_Src,g_Dest,g_About
DEF diskobj_src=NIL:PTR TO diskobject,
diskobj_dst=NIL:PTR TO diskobject
DEF maxw=100,maxh=60,img:PTR TO image
iconbase:=OpenLibrary('icon.library',37)
bguibase:=OpenLibrary('bgui.library',40) -> WM_WHICHOBJECT requires V40
wd_obj:=WindowObject,
WINDOW_Title,'WReplaceIcon by JT',
WINDOW_RMBTrap,TRUE,
WINDOW_AutoAspect,TRUE,
WINDOW_Position,POS_CENTERMOUSE,
WINDOW_ScaleWidth,0,
WINDOW_ScaleHeight,0,
WINDOW_AppWindow,TRUE,
WINDOW_CloseOnEsc,TRUE,
WINDOW_MasterGroup,
VGroupObject,Spacing(4),HOffset(4),VOffset(4),
StartMember,HGroupObject,Spacing(4),
StartMember,g_Src:=ButtonObject,
FRM_Type,FRTYPE_DROPBOX,
FRM_Recessed,FALSE,
LAB_Label,'_Source',
LAB_Place,PLACE_ABOVE,
GA_ID,ID_SRC,
BUTTON_Image,[0,0,maxw,maxh,0,NIL,0,0,NIL]:image,
EndObject,EndMember,
StartMember,g_Dest:=InfoObject,
FRM_Type,FRTYPE_DROPBOX,
FRM_Recessed,FALSE,
LAB_Label,'Destination',
LAB_Place,PLACE_ABOVE,
EndObject,EndMember,
EndObject,EndMember,
StartMember,g_About:=ButtonObject,
LAB_Label,'_About',
GA_ID,ID_ABOUT,
ButtonFrame,
FRM_Recessed,FALSE,
EndObject,FixMinHeight,EndMember,
EndObject,EndMember,
EndObject
IF wd_obj=NIL THEN Raise(ERR_GUI)
GadgetKey(wd_obj,g_Src,'s')
GadgetKey(wd_obj,g_About,'a')
wnd:=WindowOpen(wd_obj)
IF wnd=NIL THEN Raise(ERR_WIN)
GetAttr(WINDOW_SigMask,wd_obj,{sig})
GetAttr(WINDOW_AppMask,wd_obj,{i})
sig:=sig OR i
done:=FALSE
WHILE done=FALSE
Wait(sig)
WHILE (rc:=HandleEvent(wd_obj))<>WMHI_NOMORE
SELECT rc
CASE WMHI_CLOSEWINDOW; done:=TRUE
CASE ID_ABOUT; about()
ENDSELECT
ENDWHILE
WHILE amsg:=GetAppMsg(wd_obj)
rc:=NIL
IF amsg.numargs THEN rc:=domethod(wd_obj,[WM_WHICHOBJECT])
IF rc=g_Src
IF diskobj_src THEN FreeDiskObject(diskobj_src)
diskobj_src:=NIL
wa:=amsg.arglist[0]
diskobj_src:=getdiskobj(wa,name)
IF diskobj_src
img:=diskobj_src.gadget.gadgetrender
IF img.width>maxw OR (img.height>maxh) THEN img:=NIL
SetGadgetAttrsA(g_Src,wnd,NIL,[BUTTON_Image,img,0])
IF diskobj_src.gadget.selectrender
img:=diskobj_src.gadget.selectrender
IF img.width>maxw OR (img.height>maxh) THEN img:=NIL
SetGadgetAttrsA(g_Src,wnd,NIL,[BUTTON_SelectedImage,img,0])
ELSE
SetGadgetAttrsA(g_Src,wnd,NIL,[BUTTON_SelectedImage,img,0])
ENDIF
ELSE
SetGadgetAttrsA(g_Src,wnd,NIL,[BUTTON_Image,NIL,BUTTON_SelectedImage,NIL,0])
bguireq(NIL,'Can''t get source icon!','*_OK')
ENDIF
ELSEIF rc=g_Dest
IF diskobj_src
IF diskobj_dst THEN FreeDiskObject(diskobj_src)
diskobj_dst:=NIL
FOR i:=0 TO amsg.numargs-1
IF diskobj_dst:=getdiskobj(amsg.arglist[i],name)
CopyMem(diskobj_dst.gadget,oldgadget,SIZEOF gadget)
CopyMem(diskobj_src.gadget,diskobj_dst.gadget,SIZEOF gadget)
cd:=CurrentDir(amsg.arglist[i].lock)
IF PutDiskObject(name,diskobj_dst)=0
-> avoid Skip/Abort choice when it doesn't matter
IF bguireq(NIL,'Unable to write back icon.',
IF i=(amsg.numargs-1) THEN '*_OK' ELSE '*_Skip|_Abort')=
0 THEN i:=amsg.numargs
ENDIF
CurrentDir(cd)
CopyMem(oldgadget,diskobj_dst.gadget,SIZEOF gadget)
FreeDiskObject(diskobj_dst); diskobj_dst:=NIL
ELSE
IF bguireq(NIL,'Can''t get icon!',
IF i=(amsg.numargs-1) THEN '*_OK' ELSE '*_Skip|_Abort')=
0 THEN i:=amsg.numargs -> can't use EXIT inside IF
ENDIF
ENDFOR
ELSE
DisplayBeep(0)
ENDIF
ELSE
DisplayBeep(0)
ENDIF
ReplyMsg(amsg)
ENDWHILE
ENDWHILE
EXCEPT DO
IF wd_obj THEN DisposeObject(wd_obj)
IF bguibase THEN CloseLibrary(bguibase)
IF diskobj_dst THEN FreeDiskObject(diskobj_dst)
IF diskobj_src THEN FreeDiskObject(diskobj_src)
IF iconbase THEN CloseLibrary(iconbase)
SELECT exception
CASE ERR_LIB; WriteF('Error: could not open icon or BGUI library.\n')
CASE ERR_GUI; WriteF('Error: could not create GUI object.\n')
CASE ERR_WIN; WriteF('Error: could not open window.\n')
ENDSELECT
ENDPROC
PROC getdiskobj(wa:PTR TO wbarg,name:PTR TO CHAR)
DEF do=NIL:PTR TO diskobject,cd
StrCopy(name,wa.name)
IF name[]
cd:=CurrentDir(wa.lock)
do:=GetDiskObjectNew(name)
CurrentDir(cd)
ELSE -> drawer, garbage or disk
IF NameFromLock(wa.lock,name,StrMax(name))
SetStr(name,StrLen(name))
IF name[EstrLen(name)-1]=":" THEN StrAdd(name,'disk')
do:=GetDiskObjectNew(name)
ENDIF
ENDIF
ENDPROC do
PROC about()
bguireq('About WReplaceIcon',
'\ec\s\n'+
'Freeware\n'+
'Copyright © 1999 Jilles Tjoelker\n\n'+
'\ebE-mail:\n\enM.Tjoelker@nl.cis.philips.com\n\n'+
'\ebSnail mail:\en\nJilles Tjoelker\n'+
'Craterlaan 6\n'+
'5632 AG Eindhoven\n'+
'THE NETHERLANDS','*_OK',[{verstag}+6])
ENDPROC